home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / mac / clipboard.el < prev    next >
Encoding:
Text File  |  1994-02-21  |  2.2 KB  |  76 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993, 1994 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  7. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  8. ;;; GNU General Public License for more details.
  9. ;;;
  10.  
  11. ;;;
  12. ;;; Clipboard support functions
  13. ;;;
  14.  
  15. (defvar clipboard-name "*clipboard*")
  16. (defvar clipboard-previous-scrapcount -1)
  17.  
  18. (defun clipboard-current-scrapcount ()
  19.   (extract-internal (InfoScrap) 8 'short))
  20.  
  21. (defun string-to-scrap (s)
  22.   (ZeroScrap)
  23.   (PutScrap (length s) "TEXT" s))
  24.  
  25. (defun scrap-to-string ()
  26.   (let* ((h (NewHandle 0))
  27.          (offset (make-string 4 0))
  28.          (length (GetScrap h "TEXT" offset)))
  29.     (if (< length 0)
  30.         length
  31.       (prog2
  32.        (HLock h)
  33.        (extract-internal (deref h) 0 'string length)
  34.        (DisposHandle h)))))
  35.  
  36. (defun get-clipboard-buffer ()
  37.   (let ((clipboard (get-buffer-create clipboard-name)))
  38.     (set-buffer clipboard)
  39.     (if (not buffer-read-only)
  40.     (toggle-read-only))
  41.     clipboard))
  42.  
  43. ;;; Response to the Copy command
  44. (defun copy-region-to-clipboard ()
  45.   (let* ((old-buffer (current-buffer))
  46.      (s (buffer-substring (point) (if (mark) (mark) (point))))
  47.      (clipboard (get-clipboard-buffer)))
  48.     (set-buffer clipboard)
  49.     (toggle-read-only)
  50.     (erase-buffer)
  51.     (insert s)
  52.     (subst-char-in-region (point-min) (point-max) 10 13 t)
  53.     (string-to-scrap (buffer-string))
  54.     (subst-char-in-region (point-min) (point-max) 13 10 t)
  55.     (toggle-read-only)
  56.     (set-buffer old-buffer)))
  57.  
  58. ;;; The C code that handle activate events looks for this function by name
  59. ;;; to make sure the clipboard has the current contents of the Scrap.
  60. (defun make-clipboard-current ()
  61.   (let* ((old-buffer (current-buffer))
  62.      (clipboard (get-clipboard-buffer)))
  63.     (if (not (= (clipboard-current-scrapcount) clipboard-previous-scrapcount))
  64.     (let ((s (scrap-to-string)))
  65.       (if (stringp s)
  66.           (progn
  67.         (set-buffer clipboard)
  68.         (toggle-read-only)
  69.         (erase-buffer)
  70.         (insert s)
  71.         (subst-char-in-region (point-min) (point-max) 13 10 t)
  72.         (toggle-read-only)
  73.         (setq clipboard-previous-scrapcount (clipboard-current-scrapcount))))))
  74.     (set-buffer old-buffer)
  75.     clipboard))
  76.